unit inp;

interface
uses common;

procedure import_params(var tx:text);
{procedure read_gflip;}
procedure read_deco(addobj:integer);
procedure import_tiling_body(tinp:integer; var tx :text);
procedure import_oneof_tilings(tn,mu :integer);
procedure read_tiling(fn: mystring);
procedure import_config(var tx:text);

implementation
uses tools,decor;

procedure import_params(var tx :text);
Var
   i,j,m : integer;
begin
   readln(tx,n_pxyz);
   for i:=1 to n_pxyz do begin
      read(tx,m,pxyz2orb[i],pxyz[i],nn_pxyz[i]);
      noche[pxyz2orb[i]]:=nn_pxyz[i]; {how many chemistries/orbit?}
      for j:=1 to nn_pxyz[i] do begin
	 read(tx,ch_pxyz[i,j],dpxyz[i,j]);
	 oche[pxyz2orb[i],j]:=ch_pxyz[i,j];
      end;
      readln(tx);
   end;
   readln(tx,n_obj_ori);
   for i:=1 to n_obj_ori do begin
      read(tx,m,ori2obj[i,1],ori2obj[i,2]);
      for m:=1 to 2 do read(tx,obj_ori[i,m]);
      readln(tx);
   end;
end;
procedure read_deco(addobj:integer);
var
   tx			 : text;
   i,j,k,m,n,o,nux1,nux2 : integer;
   itp,io,l,dps		 : integer;
   no0,no1,nuoffs0,r5	 : integer;
   deco0,io3d0,dpmodel0	 : integer;
   x			 : myreal;
   och			 : array[1..t_orb,1..2] of integer;
   x5			 : v5;
   w,x3			 : v3;
   ns,ss		 : mystring;
   deco_save		 : boolean;
begin
   nipatot:=0; nipthtot:=0;
   for i:=1 to tdim do
      for j:=1 to tdim do n2n[i,j]:=false;
   for i:=1 to tdim do n2n[i,i]:=true;
   instances:=false;
   for i:=1 to tdim do
      for j:=1 to obj_of_node do begin
	 n_obj_fl[i,j]:=0;
	 n_obj_cl[i,j]:=0;
      end;
   gbflip:=false; n_objch:=0;
   for o:=1 to t_orb do osb[o]:=false;
   ns:="INPUT/objects.def";
   if(addobj=1) then ns:="INPUT/objects.fig";
   if (debug[10]) then write('Reading ',ns);
   reset(tx,ns);
   if debug[10] then writeln;
   readln(tx,ss); deconame:=strim(ss);
   readln(tx,nuoffs0);
   readln(tx,dpmodel0);
   readln(tx,r5);
   readln(tx,deco0);
   readln(tx,io3d0);
   no0:=1;
   readln(tx,no1);
   readln(tx);
   if(addobj=1) then begin
      if(dpmodel<>dpmodel0)then begin
	 writeln('Fig database objects.fig: DPMODEL mismatch.');
	 halt;
      end;
      if(nuoffs0<>nu_offs)then begin
	 writeln('Fig database objects.fig: NU-offset mismatch.');
	 halt;
      end;
      if(io3d0<>io3d) then begin
	 writeln('Fig database objects.fig: 3D object extension mismatch.');
	 halt;
      end;
      no0:=n_obj+1;
      no1:=n_obj+no1;
      deco_save:=deco;
      deco:=false;
   end else begin
      dpmodel:=dpmodel0;
      io3d:=io3d0;
      nu_offs:=nuoffs0;
      repre5:=false;
      if (r5>0) then repre5:=true;
      deco:=(deco0=1);
      deco_save:=deco;
      if debug[11] then begin
	 writeln('5D representation : ',repre5);
	 write('3D objects : ');
	 if (io3d>0) then writeln('YES') else writeln('NO');
      end;
   end;
   if (dpmodel=0) then flavours:=false else flavours:=true;
   if debug[11] then writeln('OBJ-FLAVOURS : ',flavours);
   for i:=no0 to no1 do begin
      readln(tx,o,obj_code[i],ss); obj_name[i]:=strim(ss);
      if (not(deco)) then begin
	 obj_stx[i]:=0.0; obj_ch[i]:=0.0;
	 obj_ham[i]:=0.0; obj_stn[i]:=0;
	 {writeln('DBG ',obj_name[i],' ',obj_code[i]:1);}
	 {codes <99 reserved for binding chemical potential to an object}
	 if (obj_code[i]<99) then begin
	    j:=obj_code[i];
	    if (j>n_objch) then n_objch:=j;
	    readln(tx,obj_stx[j],obj_ch[j]);
	 end else begin readln(tx,obj_ham[i]) end;
	 if (debug[11]) then writeln(i:1,' ',obj_ham[i]:1:3,' ',obj_name[i]);
      end;
      if(deco) then readln(tx,o); {atoms bound to object}
      read(tx,obj_nipat[i]);
      nipatot:=nipatot+1;
      for o:=1 to obj_nipat[i] do read(tx,obj_inst[i,o]);
      readln(tx);
      {readln(tx,obj_nipat[i]);}
      if(obj_nipat[i]>0) then instances:=true;
      read(tx,obj_nipth[i]);
      for o:=1 to obj_nipth[i] do read(tx,obj_ipth[i,o]);
      readln(tx);
      nipthtot:=nipthtot+1;
      if(obj_nipth[i]>0) then instances:=true;
      {writeln('yyy ',obj_name[i],' ',obj_nipat[i]:1);}
      readln(tx,obj_mu[i]);
      for m:=1 to obj_mu[i] do obj_at_mu[i,m]:=0; {atoms; will be re-read from ap.def}
      readln(tx,obj_pth[i]); {object path length}
      readln(tx,obj_nfl[i]); {obj-sym-break}
      {writeln('XXXobj_nfl ',i:1,' ',obj_nfl[i]:1);}
      if(obj_nfl[i]>1) then begin
	 {for j:=1 to obj_nfl[i] do begin
	 for o:=1 to 3 do read(tx,obj_fla[i,j,o]);
	 readln(tx);
	 end;}
	 for m:=1 to obj_mu[i] do begin
	    for j:=1 to obj_nfl[i] do begin
	       for o:=1 to 2 do read(tx,obj_flb[i,m,j,o]);
	    end; readln(tx);
	 end;
      end;
      for m:=1 to obj_mu[i] do
	 for o:=1 to 5 do obj0[i,m,o]:=0;
      readln(tx,nobcolors[i]); {user-defined colors}
      readln(tx,o); {obj-origin}
      if(o=1) then begin
	 for m:=1 to obj_mu[i] do begin
	    for o:=1 to 5 do read(tx,obj0[i,m,o]);
	    readln(tx);
	 end;	 
      end;
      readln(tx,obj_node[i,0]); {NODE STATUS}
      if(obj_node[i,0]<0) then instances:=true;
      if (io3d>0) then begin
	 for o:=-io3d to io3d do if (o<>0) then read(tx,obj_node[i,o]);
	 readln(tx);
      end;
      {writeln('YYYobjnode ',obj_node[i,-1]:1,' ',obj_node[i,1]:1);}
      for m:=1 to obj_mu[i] do begin
	 for o:=-1 to 1 do begin {reset obj_pat and obj_pth_stat}
	    for j:=1 to 10 do obj_pat_list[i,m,o,j]:=0;
	    if (m=1) then for j:=1 to obj_pth[i] do obj_pth_stat[i,o,j]:=0;
	 end;
      end;
      for m:=1 to obj_mu[i] do begin {read obj_nu and obj_pat}
	 read(tx,nux1);
	 obj_nu[i,m]:=dperp_offset(nu_offs,nux1);
	 if (io3d>0) then for o:=-io3d to io3d do begin
	    for j:=1 to 10 do read(tx,obj_pat_list[i,m,o,j]);
	 end else for j:=1 to 10 do read(tx,obj_pat_list[i,m,0,j]);
	 if(obj_nipat[i]>0) then begin
	    for k:=1 to obj_nipat[i] do
	       for j:=1 to 10 do read(tx,obj_ipat_list[i,m,k,j]);
	 end;
	 readln(tx);
	 {write('dbg-XXXX ',obj_name[i],' ',i:2,m:3,'  ');}
      end;
      if (obj_pth[i]>0) then begin {read obj_pth_stat and obj_pth_def}
	 if (io3d>0) then for o:=-io3d to io3d do begin
	    for j:=1 to obj_pth[i] do read(tx,obj_pth_stat[i,o,j]);
	 end else for j:=1 to obj_pth[i] do read(tx,obj_pth_stat[i,0,j]);
	 readln(tx);
	 for m:=1 to obj_mu[i] do begin
	    for j:=1 to obj_pth[i] do read(tx,obj_pth_def[i,m,j]);
	    readln(tx);
	 end;
      end;
      readln(tx,ss);
      {writeln('DBG-eobj : ',obj_name[i],' ',ss);}
   end;
   close(tx);
   maxorb:=0;
   if (deco and (addobj=0)) then begin
      n_obj:=no1;
      for i:=1 to t_orb do begin och[i,1]:=0; och[i,2]:=-1; end;
      if debug[10] then write('Reading INPUT/ap.def.');
      reset(tx,'INPUT/ap.def');
      if debug[10] then writeln;
      import_params(tx);
      for i:=1 to n_obj do begin
	 for m:=1 to obj_mu[i] do begin
	    readln(tx,j,k,obj_at_mu[i,m]);
	    {writeln('inp.p :',i:1,' ',m:1,' ',obj_at_mu[i,m]:1);}
	    if(obj_at_mu[i,m]>at_in_obj)then begin
	       writeln('read_deco: Insufficient dimension at_in_obj = ',at_in_obj:1,' in common.p');
	       halt;
	    end;
	    for n:=1 to obj_at_mu[i,m] do begin
	       for o:=1 to natomrec do read(tx,bi[i,m,n,o]);
	       {USER-DEFINED OBJECT COLOR FOR AN ATOM IS INCORPORATED in field 9 of bi}
	       for o:=1 to 2 do read(tx,atp[i,m,n,o]);
	       if (atp[i,m,n,2]>maxorb) then maxorb:=atp[i,m,n,2];
	       if repre5 then begin
		  for o:=1 to 5 do read(tx,x5[o]);
		  for o:=1 to 5 do ra5[i,m,n,o]:=x5[o];
	       end;
	       readln(tx);
	       io:=atp[i,m,n,2]; {orbit}
	       if (och[io,1]=0) then och[io,2]:=atp[i,m,n,1] else begin
		  if ((bi[i,m,n,9]=1) and (atp[i,m,n,1]<>och[io,2])) then begin
		     gbflip:=true;
		     osb[io]:=true;
		     if debug[9] then writeln('SYM-BREAK: orbit ',io:1,' ',och[io,1]:1,' ',och[io,2]:1,' ',atp[i,m,n,1]:1);
		  end;
	       end;
	       if(bi[i,m,n,9]=1)then och[io,1]:=och[io,1]+1;
	    end;
	 end;
      end;
      close(tx);
      if debug[10] then writeln('Reading INPUT/olab.def');
      reset(tx,'INPUT/olab.def');
      readln(tx,k,dps);
      for i:=1 to t_orb do omu[i]:=0;
      for i:=1 to k do begin
	 readln(tx,o,l,m,n);
	 omu[i]:=m;
	 oob[i]:=n;
      end;
      close(tx);
      if debug[11] then writeln('GBFLIP : ',gbflip);
   end; {deco}
   reset(tx,'INPUT/symmetry.def');
   readln(tx,n_sym);
   for i:=1 to n_sym do begin
      for j:=1 to 10 do read(tx,sym[i,j]); readln(tx);
   end;
   close(tx);
   n_obj:=no1;
   deco:=deco_save;
   {writeln('INP: ',deco,' ',n_obj:1,' ',addobj:1);}
end; { read_deco }
procedure import_tiling_body(tinp :integer; var tx : text);
Var
   o,i,j,k : integer;
   b	   : i5;
   ss	   : mystring;
   mtx	   : text;
   bpa	   : myreal;
begin
   rewrite(mtx,'pbas.out');
   for i:=1 to 2 do
   begin
      for o:=1 to 5 do read(tx,b[o]); readln(tx);
       k:=nui(b); {should be =-nu_offs}
      bai[i]:=b;
      i5v2(bai[i],ba[i]);
      i5v2p(bai[i],bap[i]);
      {writeln('Perp basis: ');}
      bpa:=0.0;
      for o:=1 to 2 do begin write(mtx,bap[i,o]:1:5,' '); bpa:=bpa+bap[i,o]*bap[i,o] end; writeln(mtx,'   ',sqrt(bpa):1:5,' #  perp bvec ',i:1,' (x,y,mag)');
      {for o:=1 to 2 do write(ba[i,o]:1:2,' '); writeln;}
   end;
   close(mtx);
   read(tx,tnodes,multi);
   for i:=1 to tnodes do tvl[i]:=-ttvl;
   {optionally set global deconame}
   if (tinp>0) then begin
      readln(tx,ss);
      deconame:=strim(ss);
   end else readln(tx);
   tnodes0:=tnodes div multi;
   if (tnodes>tdim) then begin
      writeln('Insufficient array dim for tiling (',tdim:1,'<',tnodes:1,')');
      halt;
   end;
   for i:=-tfla to tfla do nusta[i]:=0;
   for i:=1 to tnodes do begin
      for o:=1 to 5 do read(tx,b[o]);
      if(read_tvl) then readln(tx,tvl[i],tvlpo[i]) else readln(tx);
      bt[i]:=b;
      nu[i]:=nui(bt[i]);
      nusta[nu[i]]:=nusta[nu[i]]+1;
      bound5(bt[i],rt[i]);
      k:=((i-1) div tnodes0);
      rt[i,3]:=k/multi;
   end;
   tlevels:=0; for i:=-tfla to tfla do if (nusta[i]>0) then tlevels:=tlevels+1;
   {if(tlevels=2) then sigmaflip:=true else sigmaflip:=false;}
   if((tlevels=2) and not(read_tvl)) then begin
      if(sigmaflip=false) then writeln('import_tiling_body: two-level tiling, but sigmaflip=0');
   end;
   {writeln('tlevels ',tlevels:1);
   for i:=-tfla to tfla do write(nusta[i]:1,' '); writeln;}
end; { import_tiling_body }
procedure read_tiling(fn : mystring);
var
   tx	   : text;
   i,j,k,o : integer;
   tinp	   : integer;
   b	   : i5;
begin
   if debug[10] then write('Reading '+fn,'.');
   reset(tx,fn);
   if debug[10] then writeln;
   tinp:=0; {assuming basic tiling; means wont read DECONAME}
   import_tiling_body(tinp,tx);
   close(tx);
   if debug[11] then writeln(fn+' : ',tnodes:1,' vertices.');
end; { read_tiling }
procedure import_oneof_tilings(tn,mu :integer); 
Var
   o,i,j,k,tn0 : integer;
   b       : i5;
   ss      : mystring;
begin
   for i:=-tfla to tfla do nusta[i]:=0;
   tn0:=tn div mu;
   for i:=1 to tn do begin
      for o:=1 to 5 do read(b[o]);
      readln;
      bt[i]:=b;
      nu[i]:=nui(bt[i]);
      nusta[nu[i]]:=nusta[nu[i]]+1;
      bound5(bt[i],rt[i]);
      k:=((i-1) div tn0);
      rt[i,3]:=k/mu;
   end;
   tlevels:=0; for i:=-tfla to tfla do if (nusta[i]>0) then tlevels:=tlevels+1;
   if(tlevels=2) then begin
      if(sigmaflip=false) then writeln('import_oneof_tilings: two-level tiling, but sigmaflip=0');
      {sigmaflip:=true else sigmaflip:=false;}
   end;
end; { import_oneof_tilings }
procedure import_config(var tx:text);
Var
   i,j,k,o,l,io	: integer;
   b		: i5;
   bf		: boolean;
   v,w1,w2	: v2;
   w		: v3;
begin
   l:=0; maxorb:=0;
   import_params(tx);
   for i:=1 to tnodes do begin
      readln(tx,nan[i]);
      if (nan[i]>at_of_node) then begin
	 writeln('Insufficient array dimension at_of_node=',at_of_node:1,' in common.p');
	 halt;
      end;
      for j:=1 to nan[i] do begin
	 l:=l+1;
	 for o:=1 to natomrec do read(tx,n_para[i,j,o]);
	 read(tx,n_a[i,j,1],n_a[i,j,2]);
	 if (n_a[i,j,2]>maxorb) then maxorb:=n_a[i,j,2];
	 para2xyz(n_para[i,j],n_a[i,j,1],1,1,n_r[i,j]);
	 if repre5 then begin
	    for o:=1 to 5 do read(tx,n_r5[i,j,o]);
	    {consistency check}
	    v5v2(n_r5[i,j],w1);
	    tra(w1,w2);
	    para2xyz(n_para[i,j],n_a[i,j,1],1,0,w);
	    for o:=1 to 2 do v[o]:=w[o];
	    if (dist(v,w2)>0.00001) then begin
	       writeln('Inconsistent 5D-representation ',i:1,' ',j:1);
	       write(i:1,' ',j:1,'    ');
	       for o:=1 to 2 do write(v[o]:1:5,' ');
	       write(' 5D:  ');
	       for o:=1 to 2 do write(w2[o]:1:5,' ');
	       writeln;
	       halt;
	    end;
	 end;
	 readln(tx);
	 n_a[i,j,3]:=l;
      end;
   end;
end;

end.
